home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / w3 / w3-hot.el < prev    next >
Encoding:
Text File  |  1995-08-18  |  11.8 KB  |  330 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
  3. ;;;
  4. ;;; This file is not part of GNU Emacs, but the same permissions apply.
  5. ;;;
  6. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;;; it under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10. ;;;
  11. ;;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20.  
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22. ;;; Structure for hotlists
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ;;; (
  25. ;;;  ("name of item1" . "http://foo.bar.com/")    ;; A single item in hotlist
  26. ;;;  ("name of item2" . (                         ;; A sublist
  27. ;;;                      ("name of item3" . "http://www.ack.com/")
  28. ;;;                     ))
  29. ;;; )  ; end of hotlist
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31.  
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ;;; Hotlist Handling Code
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35. (defun w3-read-html-bookmarks (fname)
  36.   "Import an HTML file into the Emacs-w3 format."
  37.   (interactive "fBookmark file: ")
  38.   (if (not (file-readable-p fname))
  39.       (error "Can not read %s..." fname))
  40.   (save-excursion
  41.     (set-buffer (get-buffer-create " *bookmark-work*"))
  42.     (erase-buffer)
  43.     (mm-insert-file-contents fname)
  44.     (let ((parse (w3-preparse-buffer (current-buffer) t))
  45.       (booklist nil))
  46.       booklist)))
  47.  
  48. (defun w3-draw-air-hotlist-as-html (hotlist-data)
  49.   ;; Draw an AIR-Mosaic style hotlist as HTML.
  50.   (set-buffer (get-buffer-create url-working-buffer))
  51.   (erase-buffer)
  52.   (insert "<html>\n\t<head>\n\t\t"
  53.       "<title> Hotlist </title>\n\t</head>\n"
  54.       "\t<body>\n\t\t<div1>\n\t\t\t<h1>Hotlist data"
  55.       "</h1>\n\t\t\t<ul>\n")
  56.   (w3-draw-air-sublist hotlist-data)
  57.   (insert "\t\t\t</ul>\n\t\t</div1>\n\t</body>\n</html>\n"))
  58.  
  59. (defun w3-draw-air-sublist (data)
  60.   ;; Draw a sublist of an AIR Mosaic style hotlist
  61.   (let ((ttl (car data)))
  62.     (setq data (cdr (cdr data)))
  63.     (insert "<ul>\n"
  64.         " <li> " ttl "\n"
  65.         "  <ul>\n")
  66.     (while data
  67.       (cond
  68.        ((and (listp (car data)) (null (nth 1 (car data))))
  69.     (w3-draw-air-sublist (car data)))
  70.        ((listp (car data))
  71.     (insert "    <li> <a href=\""
  72.         (nth 1 (car data)) "\">"
  73.         (nth 0 (car data)) "</a></li>\n"))
  74.        (t 'undefined))
  75.       (setq data (cdr data)))
  76.     (insert "  </ul>\n"
  77.         " </li>\n"
  78.         "</ul>\n")))
  79.  
  80. (defun w3-parse-air-hotlist (&optional fname)
  81.   ;; Read in an AIR-Mosaic style hotlist and parse it.
  82.   (if (not fname) (setq fname w3-hotlist-file))
  83.   (setq w3-hotlist nil)
  84.   (if (not (and (file-exists-p fname) (file-readable-p fname)))
  85.       (message "%s does not exist!" fname)
  86.     (save-excursion
  87.       (set-buffer (get-buffer-create " *w3-temp*"))
  88.       (erase-buffer)
  89.       (mm-insert-file-contents fname)
  90.       (goto-char (point-min))
  91.       (if (not (looking-at "^Hotlist\r*$"))
  92.       (error "%s is not in hotlist format!" fname))
  93.       (url-replace-regexp "^[ \t]*{[ \t\r]*$" "(")
  94.       (url-replace-regexp "^[ \t]*}[ \t\r]*$" ")")
  95.       (url-replace-regexp "^Hotlist\r*$" "(")
  96.       (url-replace-regexp "^[ \t]*\\(Sublist\\|Item\\)[ \t\r]*$"
  97.               ")(")
  98.       (goto-char (point-min))
  99.       (catch 'ack
  100.     (while (not (eobp))
  101.       (beginning-of-line)
  102.       (if (not (looking-at "^[ \t]*[()]+[ \t\r]*$"))
  103.           (progn
  104.         (skip-chars-forward " \t\r")
  105.         (insert "\"")
  106.         (end-of-line)
  107.         (skip-chars-backward " \t\r")
  108.         (insert "\"")))
  109.       (condition-case ()
  110.           (next-line 1)
  111.         (error (throw 'ack t)))))
  112.       (goto-char (point-max))
  113.       (insert "\n)")
  114.       (let ((dat nil))
  115.     (goto-char (point-min))
  116.     (condition-case ()
  117.         (setq dat (read (current-buffer)))
  118.       (error nil))
  119.     dat))))
  120.  
  121. (defun w3-hotlist-apropos (regexp)
  122.   "Show hotlist entries matching REGEXP."
  123.   (interactive "sW3 Hotlist Apropos (regexp): ")
  124.   (or w3-setup-done (w3-do-setup))
  125.   (let ((save-buf (get-buffer "Hotlist")) ; avoid killing this
  126.     (w3-hotlist
  127.      (apply
  128.       'nconc
  129.       (mapcar
  130.        (function
  131.         (lambda (entry)
  132.           (if (or (string-match regexp (car entry))
  133.               (string-match regexp (car (cdr entry))))
  134.           (list entry))))
  135.        w3-hotlist))))
  136.     (if (not w3-hotlist)
  137.     (message "No w3-hotlist entries match \"%s\"" regexp)
  138.       (and save-buf (save-excursion
  139.               (set-buffer save-buf)
  140.               (rename-buffer (concat "Hotlist during " regexp))))
  141.       (unwind-protect
  142.       (progn
  143.         (w3-show-hotlist)
  144.         (rename-buffer (concat "Hotlist \"" regexp "\""))
  145.         (setq url-current-file (concat "hotlist/" regexp)))
  146.     (and save-buf (save-excursion
  147.             (set-buffer save-buf)
  148.             (rename-buffer "Hotlist")))
  149.     ))))
  150.  
  151. (defun w3-hotlist-refresh ()
  152.   "Reload the default hotlist file into memory"
  153.   (interactive)
  154.   (w3-parse-hotlist)
  155.   (if (fboundp 'w3-add-hotlist-menu) (w3-add-hotlist-menu)))
  156.  
  157. (defun w3-delete-from-alist (x alist)
  158.   ;; Remove X from ALIST, return new alist
  159.   (if (eq (assoc x alist) (car alist)) (cdr alist)
  160.     (delq (assoc x alist) alist)))
  161.  
  162. (defun w3-hotlist-delete ()
  163.   "Deletes a document from your hotlist file"
  164.   (interactive)
  165.   (save-excursion
  166.     (if (not w3-hotlist) (message "No hotlist in memory!")
  167.       (if (not (file-exists-p w3-hotlist-file))
  168.       (message "Hotlist file %s does not exist." w3-hotlist-file)
  169.     (let* ((completion-ignore-case t)
  170.            (title (car (assoc (completing-read "Delete Document: "
  171.                            w3-hotlist nil t)
  172.                   w3-hotlist)))
  173.            (case-fold-search nil)
  174.            (buffer (get-buffer-create " *HOTW3*")))
  175.       (and (string= title "") (error "No document specified."))
  176.       (set-buffer buffer)
  177.       (erase-buffer)
  178.       (mm-insert-file-contents w3-hotlist-file)
  179.       (goto-char (point-min))
  180.       (if (re-search-forward (concat "^" (regexp-quote title) "\r*$")
  181.                  nil t)
  182.           (progn
  183.         (previous-line 1)
  184.         (beginning-of-line)
  185.         (delete-region (point) (progn (forward-line 2) (point)))
  186.         (write-file w3-hotlist-file)
  187.         (setq w3-hotlist (w3-delete-from-alist title w3-hotlist))
  188.         (kill-buffer (current-buffer)))
  189.         (message "%s was not found in %s" title w3-hotlist-file))))))
  190.   (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
  191.  
  192. (defun w3-hotlist-rename-entry (title)
  193.   "Rename a hotlist item"
  194.   (interactive (list (let ((completion-ignore-case t))
  195.                (completing-read "Rename entry: " w3-hotlist nil t))))
  196.   (cond                    ; Do the error handling first
  197.    ((string= title "") (error "No document specified!"))
  198.    ((not w3-hotlist) (error "No hotlist in memory!"))
  199.    ((not (file-exists-p (expand-file-name w3-hotlist-file)))
  200.     (error "Hotlist file %s does not exist." w3-hotlist-file))
  201.    ((not (file-readable-p (expand-file-name w3-hotlist-file)))
  202.     (error "Hotlist file %s exists, but is unreadable." w3-hotlist-file)))
  203.   (save-excursion
  204.     (let ((obj (assoc title w3-hotlist))
  205.       (used (mapcar 'car w3-hotlist))
  206.       (buff (get-buffer-create " *HOTW3*"))
  207.       (new nil)
  208.       )
  209.       (while (or (null new) (member new used))
  210.     (setq new (read-string "New name: ")))
  211.       (set-buffer buff)
  212.       (erase-buffer)
  213.       (mm-insert-file-contents (expand-file-name w3-hotlist-file))
  214.       (goto-char (point-min))
  215.       (if (re-search-forward (regexp-quote title) nil t)
  216.       (progn
  217.         (previous-line 1)
  218.         (beginning-of-line)
  219.         (delete-region (point) (progn (forward-line 2) (point)))
  220.         (w3-insert (format "%s %s\n%s\n" (nth 1 obj) (current-time-string)
  221.                 new))
  222.         (setq w3-hotlist (cons (list new (nth 1 obj))
  223.                    (w3-delete-from-alist title w3-hotlist)))
  224.         (write-file w3-hotlist-file)
  225.         (kill-buffer (current-buffer))
  226.         (if (and w3-running-FSF19 (not (eq 'tty (device-type))))
  227.         (progn
  228.           (delete-menu-item '("Go"))
  229.           (w3-build-FSF19-menu))))
  230.     (message "%s was not found in %s" title w3-hotlist-file))))
  231.   (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
  232.  
  233. (defun w3-hotlist-append (fname)
  234.   "Append a hotlist to the one in memory"
  235.   (interactive "fAppend hotlist file: ")
  236.   (let ((x w3-hotlist))
  237.     (w3-parse-hotlist fname)
  238.     (setq w3-hotlist (nconc x w3-hotlist))
  239.     (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))))
  240.  
  241. (defun w3-parse-hotlist (&optional fname)
  242.   "Read in the hotlist specified by FNAME"
  243.   (if (not fname) (setq fname w3-hotlist-file))
  244.   (setq w3-hotlist nil)
  245.   (if (not (file-exists-p fname))
  246.       (message "%s does not exist!" fname)
  247.     (let* ((old-buffer (current-buffer))
  248.        (buffer (get-buffer-create " *HOTW3*"))
  249.        cur-link
  250.        cur-alias)
  251.       (set-buffer buffer)
  252.       (erase-buffer)
  253.       (mm-insert-file-contents fname)
  254.       (goto-char (point-min))
  255.       (while (re-search-forward "^\n" nil t) (replace-match ""))
  256.       (goto-line 3)
  257.       (while (not (eobp))
  258.     (re-search-forward "^[^ ]*" nil t)
  259.     (setq cur-link (buffer-substring (match-beginning 0) (match-end 0)))
  260.     (setq cur-alias (buffer-substring (progn
  261.                         (forward-line 1)
  262.                         (beginning-of-line)
  263.                         (point))
  264.                       (progn
  265.                         (end-of-line)
  266.                         (point))))
  267.     (if (not (equal cur-alias ""))
  268.         (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))))
  269.       (kill-buffer buffer)
  270.       (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))
  271.       (set-buffer old-buffer))))
  272.  
  273. ;;;###autoload
  274. (defun w3-use-hotlist ()
  275.   "Possibly go to a link in your W3/Mosaic hotlist.
  276. This is part of the emacs World Wide Web browser.  It will prompt for
  277. one of the items in your 'hotlist'.  A hotlist is a list of often
  278. visited or interesting items you have found on the World Wide Web."
  279.   (interactive)
  280.   (if (not w3-setup-done) (w3-do-setup))
  281.   (if (not w3-hotlist) (message "No hotlist in memory!")
  282.     (let* ((completion-ignore-case t)
  283.        (url (car (cdr (assoc
  284.                (completing-read "Goto Document: " w3-hotlist nil t)
  285.                w3-hotlist)))))
  286.       (if (string= "" url) (error "No document specified!"))
  287.       (w3-fetch url))))
  288.  
  289. (defun w3-hotlist-add-document-at-point (pref-arg)
  290.   "Add the document pointed to by the hyperlink under point to the hotlist."
  291.   (interactive "P")
  292.   (let ((url (w3-view-this-url t))
  293.     (title "nil"))
  294.     (or url (error "No link under point."))
  295.     (setq title (nth 3 (w3-zone-data (w3-zone-at (point)))))
  296.     (w3-hotlist-add-document pref-arg title url)
  297.     (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))))
  298.  
  299. (defun w3-hotlist-add-document (pref-arg &optional the-title the-url)
  300.   "Add this documents url to the hotlist"
  301.   (interactive "P")
  302.   (save-excursion
  303.     (let* ((buffer (get-buffer-create " *HOTW3*"))
  304.        (title (or the-title
  305.               (and pref-arg (read-string "Title: "))
  306.               (buffer-name)))
  307.        (url (or the-url (url-view-url t))))
  308.       (if (rassoc (list url) w3-hotlist)
  309.       (error "That item already in hotlist, use w3-hotlist-rename-entry."))
  310.       (set-buffer buffer)
  311.       (erase-buffer)
  312.       (setq w3-hotlist (cons (list title url) w3-hotlist)
  313.         url (url-unhex-string url))
  314.       (if (not (file-exists-p w3-hotlist-file))
  315.       (progn
  316.         (message "Creating hotlist file %s" w3-hotlist-file)
  317.         (w3-insert "ncsa-xmosaic-hotlist-format-1\nDefault\n\n")
  318.         (backward-char 1))
  319.     (progn
  320.       (mm-insert-file-contents w3-hotlist-file)
  321.       (goto-char (point-max))
  322.       (backward-char 1)))
  323.       (w3-insert "\n" (url-hexify-string url) " " (current-time-string)
  324.          "\n" title)
  325.       (write-file w3-hotlist-file)
  326.       (kill-buffer (current-buffer))))
  327.       (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))
  328.  
  329. (provide 'w3-hot)
  330.